home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / GraphicOps.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-07-07  |  22.1 KB  |  533 lines  |  [.Ob./.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. FoldElems
  5. Syntax10.Scn.Fnt
  6.     BEGIN X := SHORT(x); Y := SHORT(y)
  7.     END StdScale;
  8. Syntax10.Scn.Fnt
  9.     BEGIN IF (F.X <= X) & (X < F.X + F.W) & (F.Y <= Y) & (Y < F.Y + F.H) THEN Pluto.ReplConst(X, Y, 1, 1) END
  10.     END PDot;
  11. Syntax10.Scn.Fnt
  12.     BEGIN Display.ReplConstC(F, col, X, Y, W, H, mode)
  13.     END DBlock;
  14. Syntax10.Scn.Fnt
  15.     BEGIN
  16.         IF X < F.X THEN DEC(W, F.X - X); X := F.X END;
  17.         IF X+W > F.X + F.W THEN W := F.X + F.W - X END;
  18.         IF Y < F.Y THEN DEC(H, F.Y - Y); Y := F.Y END;
  19.         IF Y+H > F.Y + F.H THEN H := F.Y + F.H - Y END;
  20.         IF (W > 0) & (H > 0) THEN Pluto.ReplConst(X, Y, W, H) END
  21.     END PBlock;
  22. Syntax10.Scn.Fnt
  23.     BEGIN
  24.         IF F = Printer THEN
  25.             Dot := PDot;
  26.             Block := PBlock;
  27.         ELSE
  28.             Dot := Display.DotC;
  29.             IF pat = 0 THEN Block := DBlock
  30.             ELSE Block := Display.ReplPatternC
  31.             END
  32.         END;
  33.         IF col = invert THEN mode := Display.invert
  34.         ELSE mode := Display.replace
  35.         END
  36.     END SetUp;
  37. Syntax10.Scn.Fnt
  38. Syntax10i.Scn.Fnt
  39. FoldElems
  40. Syntax10.Scn.Fnt
  41.         BEGIN min := x1; max := x1;
  42.             IF x2 < min THEN min := x2 ELSIF x2 > max THEN max := x2 END;
  43.             IF x3 < min THEN min := x3 ELSIF x3 > max THEN max := x3 END;
  44.             IF x4 < min THEN min := x4 ELSIF x4 > max THEN max := x4 END
  45.         END MinMax;
  46. Syntax10.Scn.Fnt
  47.         BEGIN
  48.             p.x := x1; p.dx := x2-x1;
  49.             IF p.dx > 0 THEN p.inx := 1 ELSIF p.dx < 0 THEN p.inx := -1; p.dx := -p.dx ELSE p.inx := 0 END;
  50.             p.y := y1; p.dy := y2-y1;
  51.             IF p.dy > 0 THEN p.iny := 1 ELSIF p.dy < 0 THEN p.iny := -1; p.dy := -p.dy ELSE p.iny := 0 END;
  52.             p.d := p.dy - p.dx; p.dx := 2*p.dx; p.dy := 2*p.dy;
  53.         END InitLineParms;
  54. Syntax10.Scn.Fnt
  55. Syntax10i.Scn.Fnt
  56.         BEGIN (* H = (d(x, y) := (2*x - 2*x1 + 1)*dy - (2*y - 2*y1 + 1)*dx < 0) *)
  57.             WHILE p.d < 0 DO INC(p.x, p.inx); INC(p.d, p.dy) END;
  58.             p.drawX := p.x; p.drawY := p.iny DIV 2 + p.y;
  59.             DEC(p.d, p.dx); INC(p.y, p.iny);
  60.         END LineStep;
  61.         (* B. Stamm *)
  62.         TYPE LineParms = RECORD x, y, d, dx, dy, inx, iny, drawX, drawY: INTEGER END;
  63.         VAR left, right: LineParms;
  64.             X0, Y0, X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y, RHS2, RHS3, Xmin, Xmax, Ymin, Ymax: INTEGER;
  65.             Dot: DotProc; Block: BlockProc; mode: INTEGER;
  66.         PROCEDURE MinMax(x1, x2, x3, x4: INTEGER; VAR min, max: INTEGER);    
  67.         PROCEDURE InitLineParms(x1, y1, x2, y2: INTEGER; VAR p: LineParms);    
  68.         PROCEDURE LineStep(VAR p: LineParms);     
  69.     BEGIN
  70.         Scale(F, x1, y1, X1, Y1);
  71.         Scale(F, x2, y2, X2, Y2);
  72.         Scale(F, x3, y3, X3, Y3);
  73.         Scale(F, x4, y4, X4, Y4);
  74.         MinMax(X1, X2, X3, X4, Xmin, Xmax);
  75.         MinMax(Y1, Y2, Y3, Y4, Ymin, Ymax);
  76.         IF (F.X < Xmax) & (Xmin < F.X + F.W) & (F.Y < Ymax) & (Ymin < F.Y + F.H) THEN (* quadrangle may be visible *)
  77.             SetUp(F, Dot, Block, col, mode, pat);
  78.             Scale(F, 0, 0, X0, Y0);
  79.             IF (Y1 > Y2) OR (Y1 = Y2) & (X1 > X2) THEN X := X1; X1 := X2; X2 := X; Y := Y1; Y1 := Y2; Y2 := Y END;
  80.             IF (Y2 > Y3) OR (Y2 = Y3) & (X2 > X3) THEN X := X2; X2 := X3; X3 := X; Y := Y2; Y2 := Y3; Y3 := Y END;
  81.             IF (Y3 > Y4) OR (Y3 = Y4) & (X3 > X4) THEN X := X3; X3 := X4; X4 := X; Y := Y3; Y3 := Y4; Y4 := Y END;
  82.             IF (Y1 > Y2) OR (Y1 = Y2) & (X1 > X2) THEN X := X1; X1 := X2; X2 := X; Y := Y1; Y1 := Y2; Y2 := Y END;
  83.             IF (Y2 > Y3) OR (Y2 = Y3) & (X2 > X3) THEN X := X2; X2 := X3; X3 := X; Y := Y2; Y2 := Y3; Y3 := Y END;
  84.             IF (Y1 > Y2) OR (Y1 = Y2) & (X1 > X2) THEN X := X1; X1 := X2; X2 := X; Y := Y1; Y1 := Y2; Y2 := Y END;
  85.             IF LONG(X2-X1)*LONG(Y4-Y1) > LONG(Y2-Y1)*LONG(X4-X1) THEN RHS2 := 2 ELSE RHS2 := 0 END;
  86.             IF LONG(X3-X1)*LONG(Y4-Y1) > LONG(Y3-Y1)*LONG(X4-X1) THEN RHS3 := 1 ELSE RHS3 := 0 END;
  87.             CASE RHS2 + RHS3 OF
  88.                 | 0: InitLineParms(X1, Y1, X2, Y2, left); InitLineParms(X1, Y1, X4, Y4, right);
  89.                 | 1: InitLineParms(X1, Y1, X2, Y2, left); InitLineParms(X1, Y1, X3, Y3, right);
  90.                 | 2: InitLineParms(X1, Y1, X3, Y3, left); InitLineParms(X1, Y1, X2, Y2, right);
  91.                 | 3: InitLineParms(X1, Y1, X4, Y4, left); InitLineParms(X1, Y1, X2, Y2, right);
  92.             END;
  93.             WHILE left.y # Y2 DO
  94.                 LineStep(left); LineStep(right);
  95.                 Block(F, col, pat, left.drawX, left.drawY, right.drawX-left.drawX, 1, X0, Y0, mode)
  96.             END;
  97.             CASE RHS2 + RHS3 OF
  98.                 | 0: InitLineParms(X2, Y2, X3, Y3, left);
  99.                 | 1: InitLineParms(X2, Y2, X4, Y4, left);
  100.                 | 2: InitLineParms(X2, Y2, X4, Y4, right);
  101.                 | 3: InitLineParms(X2, Y2, X3, Y3, right);
  102.             END;
  103.             WHILE left.y # Y3 DO
  104.                 LineStep(left); LineStep(right);
  105.                 Block(F, col, pat, left.drawX, left.drawY, right.drawX-left.drawX, 1, X0, Y0, mode)
  106.             END;
  107.             CASE RHS2 + RHS3 OF
  108.                 | 0, 2: InitLineParms(X3, Y3, X4, Y4, left);
  109.                 | 1, 3: InitLineParms(X3, Y3, X4, Y4, right);
  110.             END;
  111.             WHILE left.y # Y4 DO
  112.                 LineStep(left); LineStep(right);
  113.                 Block(F, col, pat, left.drawX, left.drawY, right.drawX-left.drawX, 1, X0, Y0, mode)
  114.             END
  115.         END
  116.     END Quadrangle;
  117. Syntax10.Scn.Fnt
  118. FoldElems
  119. Syntax10.Scn.Fnt
  120. Syntax10i.Scn.Fnt
  121.             VAR x, y, dx, dy, d, inc, L, B, R, T, Xmin, Xmax, Ymin, Ymax: INTEGER;
  122.                 Dot: DotProc; Block: BlockProc; mode: INTEGER;
  123.         BEGIN
  124.             L := F.X; B := F.Y; R := F.X + F.W; T := F.Y + F.H;
  125.             IF X0 < X1 THEN Xmin := X0; Xmax := X1 ELSE Xmin := X1; Xmax := X0 END;
  126.             IF Y0 < Y1 THEN Ymin := Y0; Ymax := Y1 ELSE Ymin := Y1; Ymax := Y0 END;
  127.             IF (L <= Xmax) & (Xmin < R) & (B <= Ymax) & (Ymin < T) THEN (* line may be visible *)
  128.                 SetUp(F, Dot, Block, col, mode, pat);
  129.                 IF Xmin = Xmax THEN Block(F, col, pat, Xmin, Ymin, 1, Ymax-Ymin+1, col, 0, 0)
  130.                 ELSIF Ymin = Ymax THEN Block(F, col, pat, Xmin, Ymin, Xmax-Xmin+1, 1, col, 0, 0)
  131.                 ELSE
  132.                     IF (Y1-Y0) < (X0-X1) THEN x := X0; X0 := X1; X1 := x; y := Y0; Y0 := Y1; Y1 := y END;
  133.                     dx := 2*(X1-X0); dy := 2*(Y1-Y0); x := X0; y := Y0; inc := 1;
  134.                     IF (L <= Xmin) & (Xmax < R) & (B <= Ymin) & (Ymax < T) THEN (* no clipping *)
  135.                         IF dy > dx THEN d := dy DIV 2;
  136.                             IF dx < 0 THEN inc := -1; dx := -dx END;
  137.                             WHILE y <= Y1 DO
  138.                                 Dot(F, col, x, y, mode);
  139.                                 INC(y); DEC(d, dx);
  140.                                 IF d < 0 THEN INC(d, dy); INC(x, inc) END
  141.                             END
  142.                         ELSE d := dx DIV 2;
  143.                             IF dy < 0 THEN inc := -1; dy := -dy END;
  144.                             WHILE x <= X1 DO
  145.                                 Dot(F, col, x, y, mode);
  146.                                 INC(x); DEC(d, dy);
  147.                                 IF d < 0 THEN INC(d, dx); INC(y, inc) END
  148.                             END
  149.                         END
  150.                     ELSE (* dot-wise clipping *)
  151.                         IF dy > dx THEN d := dy DIV 2;
  152.                             IF dx < 0 THEN inc := -1; dx := -dx END;
  153.                             WHILE y <= Y1 DO
  154.                                 IF (L <= x) & (x < R) & (B <= y) & (y < T) THEN Dot(F, col, x, y, mode) END;
  155.                                 INC(y); DEC(d, dx);
  156.                                 IF d < 0 THEN INC(d, dy); INC(x, inc) END
  157.                             END
  158.                         ELSE d := dx DIV 2;
  159.                             IF dy < 0 THEN inc := -1; dy := -dy END;
  160.                             WHILE x <= X1 DO
  161.                                 IF (L <= x) & (x < R) & (B <= y) & (y < T) THEN Dot(F, col, x, y, mode) END;
  162.                                 INC(x); DEC(d, dy);
  163.                                 IF d < 0 THEN INC(d, dx); INC(y, inc) END
  164.                             END
  165.                         END
  166.                     END
  167.                 END
  168.             END
  169.         END HairLine;
  170. Syntax10i.Scn.Fnt
  171.         VAR X1, Y1, X2, Y2: INTEGER; dx, dy, c: LONGREAL; u1, v1, u2, v2, u3, v3, u4, v4: LONGINT;
  172.         PROCEDURE HairLine (F: Display.Frame; X0, Y0, X1, Y1, col: INTEGER);    
  173.     BEGIN
  174.         IF d <= 0 THEN
  175.             Scale(F, x1, y1, X1, Y1);
  176.             Scale(F, x2, y2, X2, Y2);
  177.             HairLine(F, X1, Y1, X2, Y2, col)
  178.         ELSE (* thick line *)
  179.             dx := x2-x1; dy := y2-y1; c := 2 * MathL.sqrt(dx*dx + dy*dy);
  180.             IF c > 0 THEN c := d/c;
  181.                 dx := dx*c; dy := dy*c;
  182.                 u1 := ENTIER(x1-dy); v1 := ENTIER(y1+dx);
  183.                 u2 := ENTIER(x1+dy); v2 := ENTIER(y1-dx);
  184.                 u3 := ENTIER(x2-dy); v3 := ENTIER(y2+dx);
  185.                 u4 := ENTIER(x2+dy); v4 := ENTIER(y2-dx);
  186.                 Quadrangle(F, u1, v1, u2, v2, u3, v3, u4, v4, pat, col)
  187.             END
  188.         END
  189.     END Line;
  190. Syntax10.Scn.Fnt
  191. Syntax10i.Scn.Fnt
  192.         VAR X0, Y0, L, B, R, T, Li, Bi, Ri, Ti: INTEGER;
  193.             Dot: DotProc; Block: BlockProc; mode: INTEGER;
  194.     BEGIN
  195.         Scale(F, x, y, L, B);
  196.         Scale(F, x+w, y+h, R, T);
  197.         IF (F.X < R) & (L < F.X + F.W) & (F.Y < T) & (B < F.Y + F.H) THEN (* rectangle may be visible *)
  198.             SetUp(F, Dot, Block, col, mode, pat);
  199.             IF d <= 0 THEN (* hair rectangle *)
  200.                 Li := L+1; Bi := B+1; Ri := R-1; Ti := T-1;
  201.                 col := col MOD 256; X0 := 0; Y0 := 0 (* ignore pattern *)
  202.             ELSE (* thick rectangle *)
  203.                 Scale(F, 0, 0, X0, Y0);
  204.                 Scale(F, x+d, y+d, Li, Bi);
  205.                 Scale(F, x+w-d, y+h-d, Ri, Ti)
  206.             END;
  207.             IF (Li < Ri) & (Bi < Ti) THEN
  208.                 Block(F, col, pat, L, B, R-L, Bi-B, X0, Y0, mode);
  209.                 Block(F, col, pat, L, Ti, R-L, T-Ti, X0, Y0, mode);
  210.                 Block(F, col, pat, L, Bi, Li-L, Ti-Bi, X0, Y0, mode);
  211.                 Block(F, col, pat, Ri, Bi, R-Ri, Ti-Bi, X0, Y0, mode)
  212.             ELSE Block(F, col, pat, L, B, R-L, T-B, X0, Y0, mode)
  213.             END
  214.         END
  215.     END Rect;
  216. Syntax10.Scn.Fnt
  217. FoldElems
  218. Syntax10.Scn.Fnt
  219. FoldElems
  220. Syntax10.Scn.Fnt
  221.             BEGIN
  222.                 Dot(F, col, x1, y1, mode);
  223.                 Dot(F, col, x1, y2, mode);
  224.                 Dot(F, col, x2, y1, mode);
  225.                 Dot(F, col, x2, y2, mode)
  226.             END Dot4;
  227. Syntax10.Scn.Fnt
  228.             BEGIN
  229.                 IF (L <= x1) & (x1 < R) THEN
  230.                     IF (B <= y1) & (y1 < T) THEN Dot(F, col, x1, y1, mode) END;
  231.                     IF (B <= y2) & (y2 < T) THEN Dot(F, col, x1, y2, mode) END;
  232.                 END;
  233.                 IF (L <= x2) & (x2 < R) THEN
  234.                     IF (B <= y1) & (y1 < T) THEN Dot(F, col, x2, y1, mode) END;
  235.                     IF (B <= y2) & (y2 < T) THEN Dot(F, col, x2, y2, mode) END;
  236.                 END
  237.             END Dot4c;
  238. Syntax10i.Scn.Fnt
  239.             VAR x, y, dx, dy, d, L, B, Rt, T: INTEGER;
  240.             PROCEDURE Dot4 (x1, x2, y1, y2: INTEGER);    
  241.             PROCEDURE Dot4c (x1, x2, y1, y2: INTEGER);    
  242.         BEGIN
  243.             L := F.X; B := F.Y; Rt := F.X + F.W; T := F.Y + F.H;
  244.             IF (L < X+R) & (X-R < Rt) & (B < Y+R) & (Y-R < T) THEN (* circle may be visible *)
  245.                 x := R-1; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 3 - 4*R;
  246.                 IF (L <= X-R) & (X+R <= Rt) & (B <= Y-R) & (Y+R <= T) THEN (* no clipping *)
  247.                     WHILE x > y DO
  248.                         Dot4(X-x-1, X+x, Y-y-1, Y+y);
  249.                         Dot4(X-y-1, X+y, Y-x-1, Y+x);
  250.                         INC(d, dy); INC(dy, 8); INC(y);
  251.                         IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  252.                     END;
  253.                     IF x = y THEN Dot4(X-x-1, X+x, Y-y-1, Y+y) END
  254.                 ELSE (* dot-wise clipping *)
  255.                     WHILE x > y DO
  256.                         Dot4c(X-x-1, X+x, Y-y-1, Y+y);
  257.                         Dot4c(X-y-1, X+y, Y-x-1, Y+x);
  258.                         INC(d, dy); INC(dy, 8); INC(y);
  259.                         IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  260.                     END;
  261.                     IF x = y THEN Dot4c(X-x-1, X+x, Y-y-1, Y+y) END
  262.                 END
  263.             END
  264.         END HairCircle;
  265. Syntax10.Scn.Fnt
  266. FoldElems
  267. Syntax10.Scn.Fnt
  268.             BEGIN
  269.                 Dot(F, col, x1, y1, mode);
  270.                 Dot(F, col, x1, y2, mode);
  271.                 Dot(F, col, x2, y1, mode);
  272.                 Dot(F, col, x2, y2, mode)
  273.             END Dot4;
  274. Syntax10.Scn.Fnt
  275.             BEGIN
  276.                 IF (L <= x1) & (x1 < R) THEN
  277.                     IF (Bt <= y1) & (y1 < T) THEN Dot(F, col, x1, y1, mode) END;
  278.                     IF (Bt <= y2) & (y2 < T) THEN Dot(F, col, x1, y2, mode) END;
  279.                 END;
  280.                 IF (L <= x2) & (x2 < R) THEN
  281.                     IF (Bt <= y1) & (y1 < T) THEN Dot(F, col, x2, y1, mode) END;
  282.                     IF (Bt <= y2) & (y2 < T) THEN Dot(F, col, x2, y2, mode) END;
  283.                 END
  284.             END Dot4c;
  285. Syntax10i.Scn.Fnt
  286.             VAR x, y, L, Bt, R, T: INTEGER; d, dx, dy, x2, y2, a, a2, a8, b, b2, b8: LONGINT;
  287.             PROCEDURE Dot4 (x1, x2, y1, y2: INTEGER);    
  288.             PROCEDURE Dot4c (x1, x2, y1, y2: INTEGER);    
  289.         BEGIN
  290.             IF (A > 0) & (B > 0) THEN
  291.                 L := F.X; Bt := F.Y; R := F.X + F.W; T := F.Y + F.H;
  292.                 IF (L < X+A) & (X-A < R) & (Bt < Y+B) & (Y-B < T) THEN (* ellipse may be visible *)
  293.                     a := A-1; a2 := a*a; a8 := 8*a2; b := B-1; b2 := b*b; b8 := 8*b2;
  294.                     x := A-1; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a);
  295.                     IF (L <= X-A) & (X+A <= R) & (Bt <= Y-B) & (Y+B <= T) THEN (* no clipping *)
  296.                         WHILE y2 < x2 DO
  297.                             Dot4(X-x-1, X+x, Y-y-1, Y+y);
  298.                             INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2);
  299.                             IF d >= 0 THEN DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2) END
  300.                         END;
  301.                         INC(d, 4*(x2+y2) - b2+a2);
  302.                         WHILE x >= 0 DO
  303.                             Dot4(X-x-1, X+x, Y-y-1, Y+y);
  304.                             DEC(d, dx); DEC(dx, b8); DEC(x);
  305.                             IF d < 0 THEN INC(d, dy); INC(dy, a8); INC(y) END
  306.                         END
  307.                     ELSE (* dot-wise clipping *)
  308.                         WHILE y2 < x2 DO
  309.                             Dot4c(X-x-1, X+x, Y-y-1, Y+y);
  310.                             INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2);
  311.                             IF d >= 0 THEN DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2) END
  312.                         END;
  313.                         INC(d, 4*(x2+y2)-b2+a2);
  314.                         WHILE x >= 0 DO
  315.                             Dot4c(X-x-1, X+x, Y-y-1, Y+y);
  316.                             DEC(d, dx); DEC(dx, b8); DEC(x);
  317.                             IF d < 0 THEN INC(d, dy); INC(dy, a8); INC(y) END
  318.                         END
  319.                     END
  320.                 END
  321.             END
  322.         END HairEllipse;
  323. Syntax10.Scn.Fnt
  324.         BEGIN
  325.             Block(F, col, pat, x, y1, w, h, X0, Y0, mode);
  326.             Block(F, col, pat, x, y2, w, h, X0, Y0, mode)
  327.         END Line2;
  328. Syntax10.Scn.Fnt
  329.             VAR yt: INTEGER;
  330.         BEGIN yt := y1+h;
  331.             IF y1 < 0 THEN y1 := 0 END;
  332.             IF yt > LEN(line) THEN yt := LEN(line) END;
  333.             WHILE y1 < yt DO line[y1].x1 := x; line[y1].x2 := x; line[y1].x3 := x; line[y1].x4 := x+w; INC(y1) END;
  334.             yt := y2+h;
  335.             IF y2 < 0 THEN y2 := 0 END;
  336.             IF yt > LEN(line) THEN yt := LEN(line) END;
  337.             WHILE y2 < yt DO line[y2].x1 := x; line[y2].x2 := x; line[y2].x3 := x; line[y2].x4 := x+w; INC(y2) END
  338.         END Line2o;
  339. Syntax10.Scn.Fnt
  340.             VAR yt: INTEGER;
  341.         BEGIN yt := y1+h;
  342.             IF y1 < 0 THEN y1 := 0 END;
  343.             IF yt > LEN(line) THEN yt := LEN(line) END;
  344.             WHILE y1 < yt DO line[y1].x2 := x; line[y1].x3 := x+w; INC(y1) END;
  345.             yt := y2+h;
  346.             IF y2 < 0 THEN y2 := 0 END;
  347.             IF yt > LEN(line) THEN yt := LEN(line) END;
  348.             WHILE y2 < yt DO line[y2].x2 := x; line[y2].x3 := x+w; INC(y2) END
  349.         END Line2i;
  350. Syntax10.Scn.Fnt
  351.             VAR yt, x1, x2, x3, x4: INTEGER;
  352.         BEGIN yt := y+h;
  353.             IF y < 0 THEN y := 0 END;
  354.             IF yt > LEN(line) THEN yt := LEN(line) END;
  355.             WHILE y < yt DO
  356.                 x1 := line[y].x1; x2 := line[y].x2; x3 := line[y].x3; x4 := line[y].x4;
  357.                 IF x2 < x3 THEN
  358.                     Block(F, col, pat, x1, y0+y, x2-x1, 1, X0, Y0, mode);
  359.                     Block(F, col, pat, x3, y0+y, x4-x3, 1, X0, Y0, mode)
  360.                 ELSE Block(F, col, pat, x1, y0+y, x4-x1, 1, X0, Y0, mode)
  361.                 END;
  362.                 INC(y)
  363.             END
  364.         END ScanLines;
  365. Syntax10.Scn.Fnt
  366. Syntax10i.Scn.Fnt
  367.             VAR x, y, d, dx, dy, yb: INTEGER;
  368.         BEGIN DEC(R); DEC(Ri);
  369.             x := R; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*R; yb := 0;
  370.             IF Ri < 0 THEN (* filled circle *)
  371.                 WHILE x > y DO
  372.                     INC(d, dy); INC(dy, 8); INC(y);
  373.                     IF d >= 0 THEN
  374.                         Line2(F, X-x-1, Y-y, Y+yb, 2*(x+1), y-yb, col, X0, Y0);
  375.                         Line2(F, X-y, Y-x-1, Y+x, 2*y, 1, col, X0, Y0);
  376.                         DEC(d, dx); DEC(dx, 8); DEC(x); yb := y
  377.                     END
  378.                 END;
  379.                 IF x = y THEN INC(y); Line2(F, X-x-1, Y-y, Y+yb, 2*(x+1), y-yb, col, X0, Y0) END
  380.             ELSE (* outer circle *)
  381.                 DEC(Y, F.Y);
  382.                 WHILE x > y DO
  383.                     INC(d, dy); INC(dy, 8); INC(y);
  384.                     IF d >= 0 THEN
  385.                         Line2o(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb);
  386.                         Line2o(X-y, Y-x-1, Y+x, 2*y, 1);
  387.                         DEC(d, dx); DEC(dx, 8); DEC(x); yb := y
  388.                     END
  389.                 END;
  390.                 IF x = y THEN INC(y); Line2o(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb) END;
  391.                 (* inner circle *)
  392.                 x := Ri; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*Ri; yb := 0;
  393.                 WHILE x > y DO
  394.                     INC(d, dy); INC(dy, 8); INC(y);
  395.                     IF d >= 0 THEN
  396.                         Line2i(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb);
  397.                         Line2i(X-y, Y-x-1, Y+x, 2*y, 1);
  398.                         DEC(d, dx); DEC(dx, 8); DEC(x); yb := y
  399.                     END
  400.                 END;
  401.                 IF x = y THEN INC(y); Line2i(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb) END;
  402.                 (* drawing *)
  403.                 ScanLines(F, Y-R-1, 2*R+2, F.Y, col, X0, Y0)
  404.             END
  405.         END ThickCircle;
  406. Syntax10.Scn.Fnt
  407. Syntax10i.Scn.Fnt
  408.             VAR x, y, xb, yb: INTEGER; d, dx, dy, x2, y2, a, a2, a8, b, b2, b8: LONGINT;
  409.         BEGIN
  410.             IF (A > 0) & (B > 0) THEN DEC(A); DEC(Ai); DEC(B); DEC(Bi);
  411.                 a := A; a2 := a*a; a8 := 8*a2; b := B; b2 := b*b; b8 := 8*b2;
  412.                 x := A; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a); yb := 0;
  413.                 IF (Ai < 0) OR (Bi < 0) THEN (* filled ellipse *)
  414.                     WHILE y2 < x2 DO
  415.                         INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2);
  416.                         IF d >= 0 THEN
  417.                             Line2(F, X-x-1, Y-y, Y+yb, 2*(x+1), y-yb, col, X0, Y0);
  418.                             DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2); yb := y
  419.                         END
  420.                     END;
  421.                     IF y > yb THEN Line2(F, X-x-1, Y-y-1, Y+yb, 2*(x+1), y-yb+1, col, X0, Y0) END;
  422.                     INC(d, 4*(x2+y2)-b2+a2); xb := x;
  423.                     WHILE x >= 0 DO
  424.                         DEC(d, dx); DEC(dx, b8); DEC(x);
  425.                         IF d < 0 THEN
  426.                             Line2(F, X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1, col, X0, Y0);
  427.                             INC(d, dy); INC(dy, a8); INC(y); xb := x
  428.                         END
  429.                     END;
  430.                     IF x < xb THEN Line2(F, X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1, col, X0, Y0) END
  431.                 ELSE (* outer ellipse *)
  432.                     DEC(Y, F.Y);
  433.                     WHILE y2 < x2 DO
  434.                         INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2);
  435.                         IF d >= 0 THEN
  436.                             Line2o(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb);
  437.                             DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2); yb := y
  438.                         END
  439.                     END;
  440.                     IF y > yb THEN Line2o(X-x-1, Y-y-1, Y+yb, 2*(x+1), y-yb+1) END;
  441.                     INC(d, 4*(x2+y2)-b2+a2); xb := x;
  442.                     WHILE x >= 0 DO
  443.                         DEC(d, dx); DEC(dx, b8); DEC(x);
  444.                         IF d < 0 THEN
  445.                             Line2o(X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1);
  446.                             INC(d, dy); INC(dy, a8); INC(y); xb := x
  447.                         END
  448.                     END;
  449.                     IF x < xb THEN Line2o(X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1) END;
  450.                     (* inner ellipse *)
  451.                     a := Ai; a2 := a*a; a8 := 8*a2; b := Bi; b2 := b*b; b8 := 8*b2;
  452.                     x := Ai; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a); yb := 0;
  453.                     WHILE y2 < x2 DO
  454.                         INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2);
  455.                         IF d >= 0 THEN
  456.                             Line2i(X-x-1, Y-y, Y+yb, 2*(x+1), y-yb);
  457.                             DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2); yb := y
  458.                         END
  459.                     END;
  460.                     IF y > yb THEN Line2i(X-x-1, Y-y-1, Y+yb, 2*(x+1), y-yb+1) END;
  461.                     INC(d, 4*(x2+y2)-b2+a2); xb := x;
  462.                     WHILE x >= 0 DO
  463.                         DEC(d, dx); DEC(dx, b8); DEC(x);
  464.                         IF d < 0 THEN
  465.                             Line2i(X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1);
  466.                             INC(d, dy); INC(dy, a8); INC(y); xb := x
  467.                         END
  468.                     END;
  469.                     IF x < xb THEN Line2i(X-xb-1, Y-y-1, Y+y, 2*(xb+1), 1) END;
  470.                     (* drawing *)
  471.                     ScanLines(F, Y-B-1, 2*B+2, F.Y, col, X0, Y0)
  472.                 END
  473.             END
  474.         END ThickEllipse;
  475. Syntax10i.Scn.Fnt
  476.         VAR X0, Y0, X1, Y1, X2, Y2, X1i, Y1i, X2i, Y2i, A, B, Ai, Bi: INTEGER;
  477.             line: ARRAY 4096 OF RECORD x1, x2, x3, x4: INTEGER END;
  478.             Dot: DotProc; Block: BlockProc; mode: INTEGER;
  479.         PROCEDURE HairCircle (F: Display.Frame; X, Y, R, col: INTEGER);    
  480.         PROCEDURE HairEllipse (F: Display.Frame; X, Y, A, B, col: INTEGER);    
  481.         PROCEDURE Line2 (F: Display.Frame; x, y1, y2, w, h, col, X0, Y0: INTEGER);    
  482.         PROCEDURE Line2o (x, y1, y2, w, h: INTEGER);    
  483.         PROCEDURE Line2i (x, y1, y2, w, h: INTEGER);    
  484.         PROCEDURE ScanLines (F: Display.Frame; y, h, y0, col, X0, Y0: INTEGER);    
  485.         PROCEDURE ThickCircle (F: Display.Frame; X, Y, R, Ri, col, X0, Y0: INTEGER);    
  486.         PROCEDURE ThickEllipse (F: Display.Frame; X, Y, A, B, Ai, Bi, col, X0, Y0: INTEGER);    
  487.     BEGIN
  488.         Scale(F, x-a, y-b, X1, Y1);
  489.         Scale(F, x+a, y+b, X2, Y2);
  490.         IF (F.X < X2) & (X1 < F.X + F.W) & (F.Y < Y2) & (Y1 < F.Y + F.H) THEN (* ellipse may be visible *)
  491.             SetUp(F, Dot, Block, col, mode, pat);
  492.             A := (X2-X1) DIV 2; B := (Y2-Y1) DIV 2;
  493.             IF d <= 0 THEN (* hair ellipse *)
  494.                 IF A = B THEN HairCircle(F, X1+A, Y1+B, A, col)
  495.                 ELSE HairEllipse(F, X1+A, Y1+B, A, B, col)
  496.                 END
  497.             ELSE (* thick ellipse *)
  498.                 Scale(F, 0, 0, X0, Y0);
  499.                 Scale(F, x-a+d, y-b+d, X1i, Y1i);
  500.                 Scale(F, x+a-d, y+b-d, X2i, Y2i);
  501.                 Ai := (X2i-X1i) DIV 2; Bi := (Y2i-Y1i) DIV 2;
  502.                 IF (A = B) & (Ai = Bi) THEN ThickCircle(F, X1+A, Y1+B, A, Ai, col, X0, Y0)
  503.                 ELSE ThickEllipse(F, X1+A, Y1+B, A, B, Ai, Bi, col, X0, Y0)
  504.                 END
  505.             END
  506.         END
  507.     END Ellipse;
  508. MODULE GraphicOps; (* gri 25 Jan 93 *)
  509.     IMPORT Input, Display, Pluto := Printer, MathL;
  510.     CONST
  511.         invert* = -1;
  512.     TYPE
  513.         DotProc = PROCEDURE (F: Display.Frame; col, X, Y, mode: INTEGER);
  514.         BlockProc = PROCEDURE (F: Display.Frame; col: INTEGER; pat: LONGINT; X, Y, W, H, Xp, Yp, mode: INTEGER);
  515.         Scale*: PROCEDURE (F: Display.Frame; x, y: LONGINT; VAR X, Y: INTEGER);
  516.         Screen*: Display.Frame;
  517.         Printer*: Display.Frame;
  518.     PROCEDURE StdScale (F: Display.Frame; x, y: LONGINT; VAR X, Y: INTEGER);    
  519.     PROCEDURE PDot (F: Display.Frame; col, X, Y, mode: INTEGER);    
  520.     PROCEDURE DBlock (F: Display.Frame; col: INTEGER; pat: LONGINT; X, Y, W, H, Xp, Yp, mode: INTEGER);    
  521.     PROCEDURE PBlock (F: Display.Frame; col: INTEGER; pat: LONGINT; X, Y, W, H, Xp, Yp, mode: INTEGER);    
  522.     PROCEDURE SetUp (F: Display.Frame; VAR Dot: DotProc; VAR Block: BlockProc; col: INTEGER; VAR mode: INTEGER;
  523.         pat: Display.Pattern);    
  524.     PROCEDURE Quadrangle* (F: Display.Frame; x1, y1, x2, y2, x3, y3, x4, y4, pat: LONGINT; col: INTEGER);    
  525.     PROCEDURE Line* (F: Display.Frame; x1, y1, x2, y2, d, pat: LONGINT; col: INTEGER);    
  526.     PROCEDURE Rect* (F: Display.Frame; x, y, w, h, d, pat: LONGINT; col: INTEGER);    
  527.     PROCEDURE Ellipse* (F: Display.Frame; x, y, a, b, d, pat: LONGINT; col: INTEGER);    
  528. BEGIN
  529.     Scale := StdScale;
  530.     NEW(Screen); Screen.X := 0; Screen.Y := 0; Screen.W := Display.Width; Screen.H := Display.Height;
  531.     NEW(Printer); Printer.X := 0; Printer.Y := 0; Printer.W := 2200; Printer.H := 3300
  532. END GraphicOps.
  533.